COMMENT ⊗   VALID 00005 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001	   VALID 00005 PAGES 
 00002 00002	BEGIN "MAKE AN UPPER SEGMENT"
 00003 00003	THIS IS THE MECHANISM FOR READING IN PROTOTYPES
 00013 00004	GET THE GLOBAL MODEL SET UP WITH PROTOTYPES. 
 00015 00005	*****     BEGIN EXECUTION     *****
 00017 ENDMK
⊗;
BEGIN "MAKE AN UPPER SEGMENT"

REQUIRE	500			PNAMES;
REQUIRE	300			NEW_ITEMS;
REQUIRE	"PREAMB.SAI[SYS,HE]"	SOURCE_FILE;
REQUIRE "HASH[SYS,HE]"		LOAD_MODULE;
REQUIRE "<>||"			DELIMITERS;


DEFINE	READ=	<INTN(GETS)>,
	READV(V)=	<INTNV(GETS,V)>,
	READA(A)=	<INTNA(GETS,A)>,
	FILE=	<1>,
	ID=	<2>,
	FIRST1=	<1>,
	TYPE=	<OUTSTR(>,
	S1U=	<STEP 1 UNTIL>,
	ITEM!=	<ITEMCNT←ITEMCNT+1;>,
	α=	<COMMENT>,
	EOM=	<&'12&'15)>;

SAFE REAL ARRAY SIZE4[1:4];
SAFE REAL ARRAY TRAN[1:1024];
INTEGER I,J,BREAK,EOF,ITEMCNT;
STRING S;
SAFE INTEGER ARRAY HASHTAB[0:511];
SAFE STRING ARRAY PNAME[0:1024];

COMMENT	THIS IS THE MECHANISM FOR READING IN PROTOTYPES
	HANDLING NEW ITEMS IN THE WORLD;


SIMPLE INTEGER PROCEDURE CVFN(ITEM X);
BEGIN	INTEGER I;
	RETURN(IF (I←CVN(X))>1024 THEN I-3071 ELSE I);
END;

EXTERNAL INTEGER PROCEDURE HASH (STRING S);
EXTERNAL INTEGER PROCEDURE REHASH;

SIMPLE PROCEDURE HASHINDEX (STRING S;REFERENCE INTEGER I);
BEGIN
	INTEGER HOLE,PTR;
	HOLE←0;
	I←HASH(S);
	WHILE (PTR←HASHTAB[I])DO BEGIN
		IF PTR>1024 THEN PTR←PTR-3071;
		IF PTR<0 THEN HOLE←I ELSE
		IF EQU(PNAME[PTR],S) THEN RETURN;
		I←REHASH;
	END;
	IF HOLE THEN I←HOLE;
END;


SIMPLE ITEMVAR PROCEDURE INTN(STRING S);
	BEGIN ITEMVAR X;
	INTEGER F,I;
	HASHINDEX (S,I);
	IF HASHTAB[I]>0 THEN RETURN(CVI(HASHTAB[I]));
	X←CVSI(S,F);
	IF F THEN BEGIN X←GLOBAL NEW; ITEM! END;
	HASHTAB[I]←CVN(X);
	PNAME[CVFN(X)]←S;
	RETURN(X)
	END;

SIMPLE REAL ITEMVAR PROCEDURE INTNV(STRING S;REAL V);
	BEGIN REAL ITEMVAR X;
	INTEGER I;
	HASHINDEX (S,I);
	IF HASHTAB[I]>0 THEN RETURN(CVI(HASHTAB[I]));
	X←GLOBAL NEW(V); ITEM!
	HASHTAB[I]←CVN(X);
	PNAME[CVFN(X)]←S;
	RETURN(X)
	END;

SIMPLE SAFE REAL ARRAY ITEMVAR PROCEDURE INTNA(STRING S;SAFE REAL ARRAY A);
	BEGIN SAFE REAL ARRAY ITEMVAR X;
	INTEGER I;
	HASHINDEX (S,I);
	IF HASHTAB[I]>0 THEN RETURN(CVI(HASHTAB[I]));
	X←GLOBAL NEW(A);	ITEM!
	HASHTAB[I]←CVN(X);
	PNAME[CVFN(X)]←S;
	RETURN(X)
	END;

SIMPLE STRING PROCEDURE PRINTNAME(ITEMVAR X);RETURN(PNAME[CVFN(X)]);

SIMPLE STRING PROCEDURE GETS;
BEGIN	STRING S;
	S←INPUT(FILE,FIRST1);
	RETURN(INPUT(FILE,ID));
	END;

COMMENT GET THE GLOBAL MODEL SET UP WITH PROTOTYPES. ;

SIMPLE PROCEDURE SEG_INIT;
BEGIN "SEGMENT INITIALIZATION"
ITEMVAR ATR,VAL,OBJ;
REAL ITEMVAR XR;
SAFE REAL ARRAY ITEMVAR X;

IF GOT_MODELS THEN RETURN;
SETBREAK(FIRST1,"ABCDEFGHIJKLMNOPQRSTUVWXYZ","","INR");
SETBREAK(ID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789","","XNS");

α READ IN PROTOTYPES FROM DISK;
ITEMCNT←0;

OPEN(FILE,"DSK",0,2,2,120,BREAK,EOF);
LOOKUP(FILE,"MODELS.TRP[SYS,HE]",I);

IF I≠0
THEN BEGIN
	TYPE "PROTOTYPE FILE NOT FOUND." EOM;
	RELEASE(FILE);
	RETURN;
	END;

XR←READ;
WHILE XR≠NIL DO
BEGIN	;
	OUTSTR("PROTOTYPE "&CVIS(XR,I)&'12&'15);
	GLOBAL MAKE PROTOTYPE⊗SCENE≡XR;
	PUT XR IN PROTOTYPES;
	XR←READ;
	END;

XR←READV(0);
WHILE XR≠NIL DO
BEGIN	;
	GLOBAL DATUM(XR)←REALIN(FILE);
	XR←READV(0);
	END;

X←READA(SIZE4);
WHILE X≠NIL DO
BEGIN	FOR I←1 S1U 4 DO GLOBAL DATUM(X)[I]←REALIN(FILE);
	X←READA(SIZE4);
	END;

X←READ;

ATR←READ;
WHILE ATR≠NIL DO
BEGIN	OBJ←READ;
	VAL←READ;
	GLOBAL MAKE ATR⊗OBJ≡VAL;
	ATR←READ;
	END;

TYPE "PROTOTYPES READ FROM DSK." EOM;
RELEASE (FILE);
GOT_MODELS ← TRUE;

END "SEGMENT INITIALIZATION";

COMMENT *****     BEGIN EXECUTION     *****;

PUT_DATA(0,0,"SIMP");	α	THIS PUTS VERSION NUMBER INTO UPPER;
PUT_DATA(-1,CALL(0,"PJOB"),NULL);	α DELETE THE NAME,BUT LEAVE THE NUMBER;
ITEMCNT←0;
type "READING PROTOTYPES FROM DISK" eom;
SEG_INIT;
OUTSTR(CVS(ITEMCNT)&" NEW ITEMS CREATED"&'12&'15);
TYPE "ENTER GLOBAL MODEL FILENAME" EOM;
OPEN (8,"DSK",'13,0,2,200,I,I);
ENTER(8,INCHWL&".SEG[SYS,HE]",I);
DEFINE CALLI=<'47000000000>;
START_CODE
	CALLI 1,'400022;
	TRO 1,'400000 ;
	MOVEM 1,I;
	END;
FOR J←'400000 STEP 1024 UNTIL I DO
	BEGIN START_CODE
		 HRL 1,J;
		 HRR  1,TRAN;
		 HRRZ 2,TRAN;
		 BLT 1,1023(2);
		END;
		ARRYOUT(8,TRAN[1],1024);
		END;
RELEASE (8);

END "MAKE AN UPPER SEGMENT";